home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ts_str.com / TS_DEM.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-12-25  |  7.6 KB  |  260 lines
  1. { (C) Copyright 1989 by Shenandoah Valley Software -- All Rights Reserved }
  2.  
  3. PROGRAM TS_Demo;
  4.  
  5. USES crt,ts_str;
  6.  
  7. CONST Ruler = '---------1---------2---------3---------4---------5---------6---------7---------';
  8.  
  9. VAR  FName, LName : string;
  10.      Sex, Ch      : char;
  11.      St, Name, St2: string;
  12.  
  13. PROCEDURE Header;
  14. VAR TName : string;
  15. BEGIN
  16.   ClrScr;
  17.   Writeln(Dup('-',79));
  18.   Writeln(Center('T U R B O   S T U F F   v 0 2 . 0 1 . 0 0',' ',79));
  19.   Writeln(Center('(C) Copyright 1989 by Shenandoah Valley Software -- All Rights Reserved',' ',79));
  20.   Writeln(Dup('-',79));
  21.   Writeln;
  22.   TName := 'CONST Name : string = ''' + Name + '''';
  23.   Writeln(Center(TName,' ',79));
  24.   Writeln;
  25. END;
  26.  
  27. PROCEDURE Title(TSt:string);
  28. BEGIN
  29.   Header;
  30.   TSt := ' ' + TSt + ' ';
  31.   Writeln(Center(TSt,'█',79));
  32.   Writeln;
  33. END;
  34.  
  35. PROCEDURE Wait;
  36. BEGIN
  37.   GotoXY(1,25);
  38.   Write(Center(' PRESS ANY KEY TO CONTINUE ','*',79));
  39.   Ch := ReadKey;
  40. END;
  41.  
  42. BEGIN
  43.   ClrScr;
  44.   Writeln('TS_STR Demonstration Program:');
  45.   Writeln;
  46.   Writeln;
  47.   Write('What is your first name: ');
  48.   Readln(FName);
  49.   Write('What is your last name:  ');
  50.   Readln(LName);
  51.   Write('Sex? (M)ale or (F)emale: ');
  52.   REPEAT
  53.     Sex := UpCase(ReadKey);
  54.   UNTIL Sex in ['M','F'];
  55.   Name := IIf((Sex='M'),'Mr. ','Ms. ') + Trim(FName) + ' ' + Trim(LName);
  56.   Name := Proper(Name);
  57.  
  58.   Title('ASCII and ASCIIZ');
  59.   St := ASCIIZ(Name);
  60.   Writeln('ASCIIZ(Name) ............... ',St);
  61.   Writeln;
  62.   Writeln('ASCII(Name) ................ ',ASCII(St));
  63.   Writeln;
  64.   Writeln('NOTE: ASCIIZ string is missing first digit, this is because Turbo Pascal');
  65.   Writeln('      assumes the first byte to be the length, while this is not true for');
  66.   Writeln('      an Asciiz string. Notice also that there may be garbage behind the');
  67.   Writeln('      Asciiz string as well. See TS_STR.REF for more information');
  68.   Wait;
  69.  
  70.   Title('ATRIM, LTRIM and RTRIM');
  71.   St := '**********' + UPPER(Name) + '**********';
  72.   Writeln('This is the working string (St): ',St);
  73.   Writeln;
  74.   Writeln('ATRIM(St,''*'') .............. ',ATrim(St,'*'));
  75.   Writeln('LTRIM(St,''*'') .............. ',LTrim(St,'*'));
  76.   Writeln('RTRIM(St,''*'') .............. ',RTrim(St,'*'));
  77.   Wait;
  78.  
  79.   Title('CENTER, LJUST and RJUST');
  80.   Writeln('CENTER(Name,'' '',79)');
  81.   Writeln;
  82.   Writeln(Center(Name,' ',79));
  83.   Writeln(Dup('-',79));
  84.   Writeln;
  85.   Writeln('LJUST(Name,79)');
  86.   Writeln;
  87.   Writeln(LJUST(Name,79));
  88.   Writeln(Dup('-',79));
  89.   Writeln;
  90.   Writeln('RJUST(Name,79)');
  91.   Writeln;
  92.   Writeln(RJUST(Name,79));
  93.   Writeln(Dup('-',79));
  94.   Wait;
  95.  
  96.   Title('CHANGE and DELCH');
  97.   St := '********** THIS * IS * A * TEST **********';
  98.   Writeln('This is the working string (St): ',St);
  99.   Writeln;
  100.   Write('Enter character to change astrik (*) to: ');
  101.   Readln(Ch);
  102.   Writeln;
  103.   Write('CHANGE(St,''*'',''',Ch,''') ........... ');
  104.   Writeln(CHANGE(St,'*',Ch));
  105.   Writeln;
  106.   Write('DELCH(St,''*'') ................ ',DELCH(St,'*'));
  107.   Wait;
  108.  
  109.   Title('COMPARE and SAME');
  110.   Write('COMPARE(''TURBO STUFF'',''turbo stuff'',false) ..... ');
  111.   Writeln(Compare('TURBO STUFF','turbo stuff',false));
  112.   Write('COMPARE(''TURBO STUFF'',''TURBO STUFF'',false) ..... ');
  113.   Writeln(Compare('TURBO STUFF','TURBO STUFF',false));
  114.   Write('COMPARE(''TURBO STUFF'',''turbo stuff'',true) ...... ');
  115.   Writeln(Compare('TURBO STUFF','turbo stuff',true));
  116.   Writeln;
  117.   Write('SAME(''TURBO STUFF'',''TURBO*'') ................... ');
  118.   Writeln(Same('TURBO STUFF','TURBO*'));
  119.   Write('SAME(''TURBO STUFF'',''TURBO ??UFF'') .............. ');
  120.   Writeln(Same('TURBO STUFF','TURBO ??UFF'));
  121.   Wait;
  122.  
  123.   REPEAT
  124.     Title('DECRYPT and ENCRYPT');
  125.     Write('Enter a string (press return alone to continue): ');
  126.     Readln(St);
  127.     IF St <> '' THEN BEGIN
  128.       St := Encrypt(St);
  129.       Writeln('ENCRYPT(St) ......... ',St);
  130.       Writeln;
  131.       Writeln('DECRYPT(St) ......... ',Decrypt(St));
  132.       Wait;
  133.     END;
  134.   UNTIL St = '';
  135.  
  136.   Title('DUP, DUPSTR and SPACE');
  137.   Writeln('Ch := ''*''  -  DUP(Ch,40)');
  138.   Writeln;
  139.   Writeln(Ruler);
  140.   Writeln(Dup('*',40));
  141.   Writeln;
  142.   Writeln;
  143.   Writeln('St := ''--XXX--''  -  DUPSTR(St,50)');
  144.   Writeln;
  145.   Writeln(Ruler);
  146.   Writeln(DupStr('--XXX--',50));
  147.   Writeln;
  148.   Writeln;
  149.   Writeln('SPACE(60)');
  150.   Writeln;
  151.   Writeln(Ruler);
  152.   Writeln(Space(60),'<-');
  153.   Wait;
  154.  
  155.   Title('FIRSTLOWER and FIRSTUPPER');
  156.   Writeln('FIRSTLOWER(Name) ......... ',FirstLower(Name));
  157.   Writeln('FIRSTUPPER(Name) ......... ',FirstUpper(Name));
  158.   Wait;
  159.  
  160.   Title('ISALPHA, ISLOWER and ISUPPER');
  161.   St := 'TURBOSTUFF';
  162.   Writeln('This is the working string (St): ',St);
  163.   Writeln;
  164.   Writeln('ISALPHA(St) .......... ',IsAlpha(St));
  165.   Writeln('ISLOWER(St) .......... ',IsLower(St));
  166.   Writeln('ISUPPER(St) .......... ',IsUpper(St));
  167.   Wait;
  168.  
  169.   Title('FORMAT and NUMBER');
  170.   St := '8005551212';
  171.   Writeln('This is the working string (St): ',St);
  172.   Writeln;
  173.   Writeln('A phone number:  FORMAT(St,''(###)-###-####'') ..... ',Format(St,'(###)-###-####'));
  174.   Writeln('A normal number: NUMBER(St,2) .................... ',Number(St,2));
  175.   Wait;
  176.  
  177.   Title('IIF');
  178.   Writeln('The IIF function was used in conjunction wish other functions to format');
  179.   Writeln('your name. This is how it was done:');
  180.   Writeln;
  181.   Writeln('Name := IIf((Sex=''M''),''Mr. '',''Ms. '') + Trim(FName) + '' '' + Trim(LName)');
  182.   Writeln('Name := Proper(Name)');
  183.   Wait;
  184.  
  185.   Title('CENTER, LJUST and RJUST');
  186.   Writeln('CENTER(Name,''*'',79)');
  187.   Writeln;
  188.   Writeln(Center(Name,'*',79));
  189.   Writeln(Dup('-',79));
  190.   Writeln;
  191.   Writeln('LFILL(Name,''*'',79)');
  192.   Writeln;
  193.   Writeln(LFILL(Name,'*',79));
  194.   Writeln(Dup('-',79));
  195.   Writeln;
  196.   Writeln('RFILL(Name,''*'',79)');
  197.   Writeln;
  198.   Writeln(RFILL(Name,'*',79));
  199.   Writeln(Dup('-',79));
  200.   Wait;
  201.  
  202.   Title('LEFT and RIGHT');
  203.   Writeln('LEFT(Name,5) .......... ',Left(Name,5));
  204.   Writeln('RIGHT(Name,5) ......... ',Right(Name,5));
  205.   Wait;
  206.  
  207.   Title('LOCASE, LOWER, PROPER and UPPER');
  208.   Writeln('LOCASE(''A'') .................. ',LoCase('A'));
  209.   Writeln('LOWER(Name) .................. ',Lower(Name));
  210.   Writeln('PROPER(Name) ................. ',Proper(Name));
  211.   Writeln('UPPER(Name) .................. ',Upper(Name));
  212.   Wait;
  213.  
  214.   LName := Upper(LName);
  215.   REPEAT
  216.     Title('SOUNDDIF and SOUNDEX');
  217.     Writeln('Your last name .............. ',LName);
  218.     Writeln('Soundex code ................ ',Soundex(LName));
  219.     Writeln;
  220.     Write('Enter your last name and spell it wrong (return alone continues): ');
  221.     Readln(St);
  222.     St := Upper(St);
  223.     IF St <> '' THEN BEGIN
  224.       Writeln;
  225.       Writeln('Your entry .................. ',St);
  226.       Writeln('Soundex code ................ ',Soundex(St));
  227.       Writeln('SoundDif code ............... ',SoundDif(Soundex(LName),Soundex(St)));
  228.       Wait;
  229.     END;
  230.   UNTIL St = '';
  231.  
  232.   Title('STUFF');
  233.   Writeln('STUFF(''ABC'',''XYZ'',2,1) ............. ',Stuff('ABC','XYZ',2,1));
  234.   Writeln('STUFF(''ABC'','''',2,1) ................ ',Stuff('ABC','',2,1));
  235.   Writeln('STUFF(''ABC'',''XYZ'',2,0) ............. ',Stuff('ABC','XYZ',2,0));
  236.   Writeln('STUFF(''ABC'',''XYZ'',0,1) ............. ',Stuff('ABC','XYZ',0,1));
  237.   Wait;
  238.  
  239.   Title('SWAP and WORDS');
  240.   Write('Enter a string ........ ');
  241.   Readln(St);
  242.   Write('Enter another string .. ');
  243.   Readln(St2);
  244.   Writeln;
  245.   Writeln('1st string ..... ',St);
  246.   Writeln('# of words ..... ',Words(St));
  247.   Writeln('2nd string ..... ',St2);
  248.   Writeln('# of words ..... ',Words(St2));
  249.   Writeln;
  250.   Writeln('SWAP(St,St2)');
  251.   Writeln;
  252.   Swap(St,St2);
  253.   Writeln('1st string, after swap .... ',St);
  254.   Writeln('2nd string, after swap .... ',St2);
  255.   Wait;
  256.  
  257.   Title('THAT''S ALL FOLKS!');
  258.  
  259. END.
  260.